Modelling TB in possum populations
  • Introduction
  • Transmission rate
  • Mortality rate
  • Carrying capacity
  • Additional remarks
  • Extenstions to the model

On this page

  • Transmission rate
    • What happens if the transmission rate is dependent on the age groups?

Transmission model

Author

Elena Colman & Fiona Harris

Transmission rate

What happens if the transmission rate is dependent on the age groups?

Model diagram: age-dependent transmission rates

To examine the impact of age-specific transmission dynamics, we modified the model to account for different contact patterns between juveniles and adults. Instead of using a single uniform transmission rate across all age groups, we introduced three distinct contact rates to reflect behavioral differences with following transmission rate values:

  • Juvenile-to-juvenile transmission (e.g., through play and nesting interactions): \(r_{\beta 1}\)
  • Adult-to-adult transmission (e.g., through breeding and fighting): \({r_\beta 2}\)
  • Cross-age transmission between juveniles and adults (less frequent interaction): \(r_{\beta 3}\)

These values allow us to explore how increased transmission among adults (e.g., due to aggressive behaviors) might influence infection dynamics in the overall population, and how juvenile–adult interactions contribute to disease spread.

Show code
TransmissionModel <- function(time, state, parameters) {
  with(as.list(c(state, parameters)), {
    NJ <- SJ + EJ + IJ
    NAd <- SAd + EAd + IAd
    Y <- 1 / (1 + exp(-rho * (NJ + NAd - kappa)))
    X <- 1 - Y
    delta <- 0.1
    total_population <- NJ + NAd

    births_total <- X * lambda * (SAd + EAd + IAd)
    birth_SJ <- X * lambda * (SAd + EAd) + X * lambda * IAd * (1 - delta)
    births_EJ <- X * lambda * delta * IAd

    infectionJuveniles <- r_beta1 * (IJ / NJ)
    infectionAdults <- r_beta2 * (IAd / NAd)
    infectionCross <- r_beta3 * (IJ / NJ + IAd / NAd)

    dSJ <- birth_SJ - (mu * Y + gammma) * SJ - (infectionJuveniles + infectionCross) * SJ
    dEJ <- (infectionJuveniles + infectionCross) * SJ + births_EJ - (mu * Y + gammma + alpha) * EJ
    dIJ <- alpha * EJ - (mu * Y + gammma + tau) * IJ

    dSAd <- gammma * SJ - mu * Y * SAd - (infectionAdults + infectionCross) * SAd
    dEAd <- gammma * EJ + (infectionAdults + infectionCross) * SAd - (mu * Y + alpha) * EAd
    dIAd <- gammma * IJ + alpha * EAd - (mu * Y + tau) * IAd

    
      # Calculate deaths
    natural_deaths <- mu * Y * (SJ + EJ + IJ + SAd + EAd + IAd)
    tb_deaths <- tau * (IJ + IAd)
    
    # Return deaths as extra outputs
    return(list(c(dSJ, dEJ, dIJ, dSAd, dEAd, dIAd),
                natural_deaths = natural_deaths,
                tb_deaths = tb_deaths, total_population = total_population))}
    
)
}


# Simulation grid
yini <- c(SJ = 20, EJ = 0, IJ = 0, SAd = 30, EAd = 0, IAd = 1)
times <- seq(0, 7.5, by = 0.1)
params_fixed <- c(lambda = 5, kappa = 50, rho = 0.5, mu = 1/5, tau = 1, gammma = 1, alpha = 5)

# Generate simulation grid
param_grid <- expand_grid(
  r_beta1 = seq(0.5, 4.5, 0.5),
  r_beta2 = seq(0.5, 4.5, 0.5),
  r_beta3 = seq(0.5, 4.5, 0.5)
)

# Run model for each combo
sim_df <- param_grid |> 
  rowwise() |>
  mutate(sim = list(as.data.frame(
  ode(y = yini, times = times, func = TransmissionModel,
      parms = c(params_fixed, r_beta1 = r_beta1, r_beta2 = r_beta2, r_beta3 = r_beta3))
))) |>
  unnest(sim) |>
  ungroup()

ojs_define(possum_data = purrr::transpose(as.data.frame(sim_df)))


maxPopTransmission <- max(sim_df$total_population)
timeAtMaxPopTransmission <- sim_df$time[which.max(sim_df$total_population)]

ojs_define(
  maxPopTransmission = round(maxPopTransmission),
  timeAtMaxPopTransmission = round( timeAtMaxPopTransmission,1))
Show code
viewof r_beta1 = Inputs.range([0.5, 4.5], {step: 0.5, label: "Juvenile to Juvenile"})
viewof r_beta2 = Inputs.range([0.5, 4.5], {step: 0.5, label: "Adult to Adult"})
viewof r_beta3 = Inputs.range([0.5, 4.5], {step: 0.5, label: "Cross-age"})
Show code
filtered = possum_data.filter(d =>
  d.r_beta1 === r_beta1 &&
  d.r_beta2 === r_beta2 &&
  d.r_beta3 === r_beta3
)
mortality_long = filtered.flatMap(d => [
  { time: d.time, Deaths: d.natural_deaths, Mortality_Type: "Natural Mortality" },
  { time: d.time, Deaths: d.tb_deaths, Mortality_Type: "TB Mortality" }
])

compartment_long = filtered.flatMap(d => [
  { time: d.time, Count: d.SJ, Compartment: "Susceptible Juveniles" },
  { time: d.time, Count: d.EJ, Compartment: "Exposed Juveniles" },
  { time: d.time, Count: d.IJ, Compartment: "Infectious Juveniles" },
  { time: d.time, Count: d.SAd, Compartment: "Susceptible Adults" },
  { time: d.time, Count: d.EAd, Compartment: "Exposed Adults" },
  { time: d.time, Count: d.IAd, Compartment: "Infectious Adults" }
])
Show code
html`<div style="display: flex; gap: 2rem;"> 
  <div style="width: 250px; flex-shrink: 0;">
    <p><strong>Transmission Sliders</strong></p>
    <p style="font-size: 0.9em;">
    Adjust the <code>r_beta</code> values to simulate how age-dependent transmission affects TB dynamics in the possum population.
  </p>
    ${viewof r_beta1}
    ${viewof r_beta2}
    ${viewof r_beta3}
    
    <p style="font-size: 0.9em;">
    The transmission between adults adjusts the speed with which the model reaches its' equlibrium, the transmission between juveniles changes the number of juvenile possums in each group. While adjusting the cross-age parameter, changes the time infection reaches its' peak. 
    
    The population in the den will influence the population peak and come close to 51 when adult and cross-age transmissions are high. Juvenile transmission will define the long-term stable population level.
    
    The largest contributing factor to the TB mortality is the value of the cross-age parameter.
  </p>
    
    
  </div>

  <div>
      <h3>Age-dependent transmission rate</h3>
  <p><em>TB Infection Model</em></p>
  
    ${Plot.plot({
    marks: [
    Plot.lineY(compartment_long, {
    x: "time",
    y: "Count",
    stroke: "Compartment"
  }),
  ],
  color: {
    domain: [
      "Susceptible Juveniles",
      "Exposed Juveniles",
      "Infectious Juveniles",
      "Susceptible Adults",
      "Exposed Adults",
      "Infectious Adults"
    ],
    range: ["blue", "orange", "red", "green", "purple", "brown"],
    type: "ordinal",
    legend: true, 
    label: "Compartment"
  },
  x: { label: "Time (Years)" },
  y: { label: "Number of Possums" },
  width: 700,
  height: 350,
  marginLeft: 50,
  marginBottom: 40
})}
  
  
  
  <p><em>Total population over time</em></p>

    ${Plot.lineY(filtered, {
      x: "time",
      y: (d) => d.SJ + d.EJ + d.IJ + d.SAd + d.EAd + d.IAd,
      stroke: "steelblue"
    }).plot({
      y: {label: "Total Population"},
      x: {label: "Time (Years)"},
      marginLeft: 50,
      marginBottom: 40,
      width: 600,
      height: 300
    })}
 
    
      <p><em>Possum mortality</em></p>
    ${Plot.plot({
  marks: [
    Plot.lineY(mortality_long, {
      x: "time",
      y: "Deaths",
      stroke: "Mortality_Type"
    })
  ],
  color: {
     domain: ["Natural Mortality", "TB Mortality"],
    range: ["green", "red"],
    type: "ordinal",
    label: "Mortality Type",
    legend: true
    
  },
  x: {label: "Time (Years)"},
  y: {label: "Deaths per Unit Time"},
  width: 700,
  height: 350,
  marginLeft: 50,
  marginBottom: 40
})}
  </div>
</div>`